home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / vbdos / pro9 / valrepl3.bas < prev   
BASIC Source File  |  1993-03-15  |  3KB  |  94 lines
  1. DECLARE FUNCTION ValReplacement@ (TS$)
  2.  
  3. TYPE MyCurrency
  4.   MyNum AS CURRENCY
  5. END TYPE
  6.  
  7. TYPE MyLong
  8.     MyNum AS LONG
  9.     MyFil AS LONG
  10. END TYPE
  11. CLS
  12. INPUT "Enter Test Numeric String "; S$
  13. PRINT "ValR "; ValReplacement(S$)
  14. PRINT "VAL "; VAL(S$)
  15. PRINT "Benchmarking"
  16. MarkTime& = TIMER
  17. WHILE MarkTime& = TIMER: WEND
  18. FOR J% = 1 TO 32000
  19. NEXT
  20. Time3& = TIMER - MarkTime& - 1
  21. MarkTime& = TIMER
  22. WHILE MarkTime& = TIMER: WEND
  23. FOR J% = 1 TO 32000
  24.     Dmy@ = ValReplacement(S$)
  25. NEXT
  26. Time1& = TIMER - MarkTime& - 1 - Time3&
  27. MarkTime& = TIMER
  28. WHILE MarkTime& = TIMER: WEND
  29. FOR J% = 1 TO 32000
  30.     Dmy@ = VAL(S$)
  31. NEXT
  32. Time2& = TIMER - MarkTime& - 1 - Time3&
  33. PRINT Time1&; " Seconds For ValReplacement"
  34. PRINT Time2&; " Seconds For VAL"
  35. PRINT "ValReplacement:VAL Ratio ";
  36. PRINT USING "###.##"; Time1& / Time2&
  37.  
  38. 'Something fun to do during the blizzard of '93
  39. 'Replaces the VAL function when you want to eliminate floating point
  40. 'but need to VAL some strings
  41. '
  42. 'Legitimate values are - 2,147,483,647.9999 to 2,147,483,647.9999
  43. 'Benchmark to VAL is dependent on String Length AND if fractions occur
  44. '
  45. 'Courtesy of Brian McMahon 75430,717
  46. '
  47. FUNCTION ValReplacement@ (TS$)
  48.     STATIC MyCurr AS MyCurrency, MyL AS MyLong, S$, LenS%, Negate%, Skip%, Scale%, NewVal&, SaveIt@, J%
  49.     S$ = LTRIM$(RTRIM$(TS$))'get rid of any space on either end
  50.  
  51.     LenS% = LEN(S$)
  52.     IF LenS% = 0 THEN
  53.         ValReplacement = 0
  54.         EXIT FUNCTION
  55.     END IF
  56.  
  57.     IF ASC(S$) = ASC("-") THEN Negate% = 2 ELSE Negate% = 1
  58.  
  59.     Skip% = INSTR(S$, ".")
  60.  
  61.     IF Skip% THEN
  62.          Scale% = LenS% - Skip%
  63.          IF Scale% > 4 THEN LenS% = LenS% - (Scale% - 4): Scale% = 0 ELSE Scale% = 4 - Scale%
  64.          Skip% = Skip% - 1
  65.     ELSE
  66.         Skip% = LenS%
  67.     END IF
  68.  
  69.     NewVal& = 0
  70.     FOR J% = Negate% TO Skip%
  71.         NewVal& = NewVal& * 10 + ASC(MID$(S$, J%, 1)) - ASC("0")
  72.     NEXT
  73.  
  74.  
  75.     IF Skip% <> LenS% THEN 'a fraction
  76.         SaveIt@ = NewVal&  'let basic do the type casting on the first part
  77.         NewVal& = 0
  78.         Skip% = Skip% + 2
  79.         FOR J% = Skip% TO LenS%
  80.             NewVal& = NewVal& * 10 + ASC(MID$(S$, J%, 1)) - ASC("0")
  81.         NEXT
  82.         FOR J% = 1 TO Scale% 'scale the fraction
  83.            NewVal& = NewVal& * 10
  84.         NEXT
  85.         MyL.MyNum = NewVal&  ' type cast to a currency fraction
  86.         LSET MyCurr = MyL    ' via lset
  87.         IF Negate% <> 2 THEN ValReplacement = SaveIt@ + MyCurr.MyNum ELSE ValReplacement = -(SaveIt@ + MyCurr.MyNum)
  88.     ELSE
  89.         IF Negate% <> 2 THEN ValReplacement = NewVal& ELSE ValReplacement = -NewVal&
  90.     END IF
  91.  
  92. END FUNCTION
  93.  
  94.